home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / listvi1a / listview.bas < prev    next >
BASIC Source File  |  1999-09-29  |  9KB  |  334 lines
  1. Attribute VB_Name = "ListViewFuncs"
  2. Option Explicit
  3.  
  4. Public gListViewTotalSelected As Long
  5. Public gListViewSelected() As Long
  6. Public gListViewItemToInsertBefore As Long
  7.  
  8. Public Type LV_FINDINFO
  9.       
  10.       flags As Long
  11.       psz As String
  12.       lParam As Long
  13.       pt As POINTAPI
  14.       vkDirection As Long
  15.  
  16. End Type
  17.  
  18. Public Type LV_ITEM
  19.       
  20.       mask As Long
  21.       iItem As Long
  22.       iSubItem As Long
  23.       State As Long
  24.       stateMask As Long
  25.       pszText As Long
  26.       cchTextMax As Long
  27.       iImage As Long
  28.       lParam As Long
  29.       iIndent As Long
  30.  
  31. End Type
  32.  
  33. Public Const LVFI_PARAM = &H1
  34. Public Const LVFI_STRING = &H2
  35. Public Const LVFI_PARTIAL = &H8
  36. Public Const LVFI_WRAP = &H20
  37. Public Const LVFI_NEARESTXY = &H40
  38.  
  39. Declare Function GetListViewItemHeight Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As RECT) As Long
  40. Public Sub ListViewGetSelectedItems(ByVal FormToUse As Form, ByVal ListViewControl As Control)
  41.  
  42.   Dim Counter As Long
  43.   Dim SelectedCount As Long
  44.   
  45.   FormToUse.MousePointer = vbHourglass
  46.   FormToUse.Enabled = False
  47.   
  48.   SelectedCount = 0
  49.   gListViewTotalSelected = SendMessage(ListViewControl.hWnd, LVM_GETSELECTEDCOUNT, 0, 0)
  50.  
  51.   If gListViewTotalSelected > 0 Then
  52.  
  53.     ReDim gListViewSelected(gListViewTotalSelected) As Long
  54.   
  55.     For Counter = 1 To ListViewControl.ListItems.Count
  56.      
  57.        If ListViewControl.ListItems(Counter).Selected = True Then
  58.        
  59.          gListViewSelected(SelectedCount) = Counter
  60.          SelectedCount = SelectedCount + 1
  61.        
  62.        End If
  63.      
  64.     Next Counter
  65.  
  66.   End If
  67.  
  68.   FormToUse.Enabled = True
  69.   FormToUse.MousePointer = vbDefault
  70.   
  71. End Sub
  72. Public Sub AutoFitColumnWidth(ByVal lvw As ListView)
  73.  
  74.   Dim iCounter As Long
  75.  
  76.   On Error Resume Next
  77.   If lvw.View = lvwReport Then
  78.     
  79.     For iCounter = 1 To lvw.ColumnHeaders.Count
  80.    
  81.        If iCounter > 1 Then
  82.          
  83.          If lvw.ColumnHeaders(iCounter - 1).Tag = "DATE" Then
  84.  
  85.            lvw.ColumnHeaders(iCounter).Width = 0
  86.  
  87.          Else
  88.  
  89.            Call SendMessage(lvw.hWnd, LVM_SETCOLUMNWIDTH, iCounter - 1, ByVal LVSCW_AUTOSIZE_USEHEADER)
  90.  
  91.          End If
  92.          
  93.        Else
  94.          
  95.          Call SendMessage(lvw.hWnd, LVM_SETCOLUMNWIDTH, iCounter - 1, ByVal LVSCW_AUTOSIZE_USEHEADER)
  96.        
  97.        End If
  98.  
  99.     Next
  100.     
  101.   End If
  102.   Call FixSortedColumnHeaderIfNeeded(lvw)
  103.   On Error GoTo 0
  104.   
  105. End Sub
  106. Public Sub AutoSizeColumnWidth(ByVal lvw As ListView)
  107.  
  108.   Dim iCounter As Long
  109.  
  110.   On Error Resume Next
  111.   If lvw.View = lvwReport Then
  112.     
  113.     For iCounter = 1 To lvw.ColumnHeaders.Count ' - 1
  114.    
  115.        If iCounter > 1 Then
  116.          
  117.          If lvw.ColumnHeaders(iCounter - 1).Tag = "DATE" Then
  118.  
  119.            lvw.ColumnHeaders(iCounter).Width = 0
  120.  
  121.          Else
  122.  
  123.            Call SendMessage(lvw.hWnd, LVM_SETCOLUMNWIDTH, iCounter - 1, ByVal LVSCW_AUTOSIZE)
  124.  
  125.          End If
  126.        
  127.        Else
  128.          
  129.          Call SendMessage(lvw.hWnd, LVM_SETCOLUMNWIDTH, iCounter - 1, ByVal LVSCW_AUTOSIZE)
  130.          
  131.        End If
  132.  
  133.     Next
  134.     
  135.   End If
  136.   Call FixSortedColumnHeaderIfNeeded(lvw)
  137.   On Error GoTo 0
  138.   
  139. End Sub
  140.  
  141. Public Sub FixDateSortedColumnHeaderIfNeeded(ByVal ListViewToUse As ListView)
  142.     
  143.   Dim SaveFontSize As Currency
  144.   Dim SaveFontBold As Currency
  145.   Dim SaveFontName As String
  146.   
  147.   SaveFontSize = ListViewToUse.Parent.Font.Size
  148.   SaveFontBold = ListViewToUse.Parent.Font.BOLD
  149.   SaveFontName = ListViewToUse.Parent.Font.Name
  150.   
  151.   ListViewToUse.Parent.Font.Size = ListViewToUse.Font.Size
  152.   ListViewToUse.Parent.Font.BOLD = ListViewToUse.Font.BOLD
  153.   ListViewToUse.Parent.Font.Name = ListViewToUse.Font.Name
  154.   
  155.   If ListViewToUse.ColumnHeaders(IIf(ListViewToUse.SortKey = 0, 1, ListViewToUse.SortKey)).Width < ListViewToUse.Parent.TextWidth(ListViewToUse.ColumnHeaders(IIf(ListViewToUse.SortKey = 0, 1, ListViewToUse.SortKey)).Text) + ListViewToUse.Parent.TextWidth(ListViewToUse.ColumnHeaders(IIf(ListViewToUse.SortKey = 0, 1, ListViewToUse.SortKey)).Text) \ 2 Then
  156.  
  157.     ListViewToUse.ColumnHeaders(IIf(ListViewToUse.SortKey = 0, 1, ListViewToUse.SortKey)).Width = ListViewToUse.Parent.TextWidth(ListViewToUse.ColumnHeaders(IIf(ListViewToUse.SortKey = 0, 1, ListViewToUse.SortKey)).Text) + ListViewToUse.Parent.TextWidth(ListViewToUse.ColumnHeaders(IIf(ListViewToUse.SortKey = 0, 1, ListViewToUse.SortKey)).Text) \ 2
  158.  
  159.   End If
  160.   
  161.   ListViewToUse.Parent.Font.Size = SaveFontSize
  162.   ListViewToUse.Parent.Font.BOLD = SaveFontBold
  163.   ListViewToUse.Parent.Font.Name = SaveFontName
  164.  
  165. End Sub
  166. Public Sub FixSortedColumnHeaderIfNeeded(ByVal ListViewToUse As ListView)
  167.   
  168.   Dim SaveFontSize As Currency
  169.   Dim SaveFontBold As Currency
  170.   Dim SaveFontName As String
  171.   
  172.   If ListViewToUse.ColumnHeaders(IIf(ListViewToUse.SortKey = 0, 1, ListViewToUse.SortKey)).Tag = "DATE" Then
  173.     
  174.     Call FixDateSortedColumnHeaderIfNeeded(ListViewToUse)
  175.     
  176.   Else
  177.     
  178.     SaveFontSize = ListViewToUse.Parent.Font.Size
  179.     SaveFontBold = ListViewToUse.Parent.Font.BOLD
  180.     SaveFontName = ListViewToUse.Parent.Font.Name
  181.   
  182.     ListViewToUse.Parent.Font.Size = ListViewToUse.Font.Size
  183.     ListViewToUse.Parent.Font.BOLD = ListViewToUse.Font.BOLD
  184.     ListViewToUse.Parent.Font.Name = ListViewToUse.Font.Name
  185.   
  186.     If ListViewToUse.ColumnHeaders(ListViewToUse.SortKey + 1).Width < ListViewToUse.Parent.TextWidth(ListViewToUse.ColumnHeaders(ListViewToUse.SortKey + 1).Text) + ListViewToUse.Parent.TextWidth(ListViewToUse.ColumnHeaders(ListViewToUse.SortKey + 1).Text) \ 2 Then
  187.     
  188.       ListViewToUse.ColumnHeaders(ListViewToUse.SortKey + 1).Width = ListViewToUse.Parent.TextWidth(ListViewToUse.ColumnHeaders(ListViewToUse.SortKey + 1).Text) + ListViewToUse.Parent.TextWidth(ListViewToUse.ColumnHeaders(ListViewToUse.SortKey + 1).Text) \ 2
  189.     
  190.     End If
  191.   
  192.     ListViewToUse.Parent.Font.Size = SaveFontSize
  193.     ListViewToUse.Parent.Font.BOLD = SaveFontBold
  194.     ListViewToUse.Parent.Font.Name = SaveFontName
  195.     
  196.   End If
  197.  
  198. End Sub
  199. Public Function GetListViewItemIndex(ByVal hWnd As Long, ByVal ItemText As String) As Long
  200.   
  201.   Dim LFI As LV_FINDINFO
  202.   
  203.   LFI.flags = LVFI_PARTIAL Or LVFI_WRAP
  204.   LFI.psz = ItemText
  205.   
  206.   GetListViewItemIndex = SendMessageAny(hWnd, LVM_FINDITEM, -1, LFI)
  207.   
  208.   If GetListViewItemIndex <> -1 Then
  209.     
  210.     GetListViewItemIndex = GetListViewItemIndex + 1
  211.     
  212.   End If
  213.   
  214. End Function
  215. Public Sub SetListViewToWholeRowSelect(ByVal ListViewhWnd As Long)
  216.     
  217.   Dim lStyle As Long
  218.   
  219.   lStyle = SendMessage(ListViewhWnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0)
  220.   lStyle = lStyle Or LVS_EX_FULLROWSELECT
  221.   
  222.   Call SendMessage(ListViewhWnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, ByVal lStyle)
  223.  
  224. End Sub
  225.  
  226. Public Sub ShowHeaderIcon(ByVal ListViewToUse As Control, ByVal colNo As Long, ByVal showImage As Long)
  227.  
  228.   Dim r As Long
  229.   Dim hHeader As Long
  230.   Dim HD As HD_ITEM
  231.    
  232.   ListViewToUse.SmallIcons = frmListViewImages.ImageList2
  233.   
  234.   ' Get a handle to the listview header component '
  235.    hHeader = SendMessageLong(ListViewToUse.hWnd, LVM_GETHEADER, 0, 0)
  236.    
  237.   ' Set up the required structure members '
  238.   HD.mask = HDI_IMAGE Or HDI_FORMAT
  239.   HD.fmt = HDF_LEFT Or HDF_STRING Or HDF_BITMAP_ON_RIGHT Or showImage
  240.   HD.pszText = ListViewToUse.ColumnHeaders(ListViewToUse.SortKey + 1).Text
  241.   
  242.   If showImage Then
  243.     
  244.     HD.iImage = ListViewToUse.SortOrder
  245.     
  246.   End If
  247.    
  248.   ' Modify the header '
  249.   r = SendMessageAny(hHeader, HDM_SETITEM, colNo, HD)
  250.    
  251. End Sub
  252. Public Sub SortDateListView(ByVal ListViewToUse As ListView, ByVal colNo As Long)
  253.   
  254.   Dim Counter As Long
  255.   
  256.   If colNo = ListViewToUse.SortKey Then
  257.     
  258.     If ListViewToUse.SortOrder = lvwAscending Then
  259.   
  260.       ListViewToUse.SortOrder = lvwDescending
  261.     
  262.     Else
  263.      
  264.       ListViewToUse.SortOrder = lvwAscending
  265.   
  266.     End If
  267.   
  268.   End If
  269.   
  270.   ListViewToUse.Sorted = True
  271.   ListViewToUse.SortKey = colNo
  272.   
  273.   For Counter = 1 To ListViewToUse.ColumnHeaders.Count
  274.   
  275.      If Counter = colNo Then
  276.        
  277.        Call ShowHeaderIcon(ListViewT